home *** CD-ROM | disk | FTP | other *** search
/ NASA Climatology Interdisciplinary Data Collection / NASA Climatology Interdisciplinary Data Collection - Disc 4.iso / software / grads / lib / cmap.gs < prev    next >
Encoding:
Text File  |  1998-04-23  |  4.2 KB  |  223 lines
  1. function cmap (args)
  2.  
  3. if (args='') 
  4.  
  5.   say 'Enter Number of Colors: '
  6.   pull args
  7.   num = args
  8.  
  9.   i = 1
  10.   while (i<=num) 
  11.     red.i = 0
  12.     blue.i = 0
  13.     green.i = 0
  14.     cnum = i+39
  15.     'set rgb 'cnum' 127 127 127' 
  16.     i = i + 1
  17.   endwhile
  18.  
  19.   fname='grads.gct'
  20.  
  21. else
  22.  
  23.   num=0
  24.   fname=subwrd(args,1)'.gct'
  25.   while (1)
  26.     rc=read(fname)
  27.     icode=sublin(rc,1)
  28.     card=sublin(rc,2)
  29.  
  30.     if(icode = 1)
  31.       'c' 
  32.       say 'GrADS color table "'subwrd(args,1)'" file not available'
  33.       say ' '
  34.       say 'hit any key to continue'
  35.       pull tmp
  36.       quit
  37.     endif
  38.  
  39.     if(icode != 0);break;endif 
  40.  
  41.     num=num+1
  42.     red.num = subwrd(card,2)
  43.     green.num = subwrd(card,3)
  44.     blue.num = subwrd(card,4)
  45.     cnum = num+39
  46.     'set rgb 'cnum' 'red.num' 'green.num' 'blue.num
  47.   endwhile
  48.   say 'num = 'num
  49. endif
  50.  
  51. xb = 1
  52. xt = 10
  53. xi = 9/num
  54. x = xb
  55. i = 1
  56. 'set string 1 bc'
  57. while (i<=num)
  58.   x1 = x
  59.   x2 = x+xi
  60.   xm = (x1+x2)/2
  61.   cnum = i+39
  62.   'set line 'cnum
  63.   'draw recf 'x1' 7 'x2' 7.3'
  64.   'draw string 'xm' 7.5 'i
  65.   i = i + 1
  66.   x = x + xi
  67. endwhile
  68.  
  69. 'set line 1 1 1'
  70. 'draw line 3 1 3 5'
  71. 'draw line 5.5 1 5.5 5'
  72. 'draw line 8 1 8 5'
  73. 'draw line 2.9 1 3.1 1'
  74. 'draw line 2.9 5 3.1 5'
  75. 'draw line 5.4 1 5.6 1'
  76. 'draw line 5.4 5 5.6 5'
  77. 'draw line 7.9 1 8.1 1'
  78. 'draw line 7.9 5 8.1 5'
  79. r = red.1
  80. g = green.1
  81. b = blue.1
  82. ry = 1 + 4*r/255
  83. gy = 1 + 4*g/255
  84. by = 1 + 4*b/255
  85. 'draw line 3.1 'ry' 3.3 'ry
  86. 'draw line 5.6 'gy' 5.8 'gy
  87. 'draw line 8.1 'by' 8.3 'by
  88. 'set string 1 l 1'
  89. 'set strsiz 0.14 0.16'
  90. 'draw string 3.5 'ry' 'r
  91. 'draw string 6.0 'gy' 'g
  92. 'draw string 8.5 'by' 'b
  93. 'set string 1 c 6'
  94. 'set strsiz 0.16 0.18'
  95. 'draw string 5.5 6.5 1'
  96. 'draw rec 0.2 0.2 1.6 0.95'
  97. 'draw string 0.9 0.7 Save &'
  98. 'draw string 0.9 0.4 Quit'
  99.  
  100. 'set string 1 c 8'
  101. 'set strsiz 0.25'
  102. 'draw string 5.5 8.0 GrADS Color Table for :' fname
  103.  
  104. c = 1
  105. while (1) 
  106.  
  107.   'q pos'
  108.   x = subwrd(result,3)
  109.   y = subwrd(result,4)
  110.   if (x<1.6 & y<1.1); break; endif;
  111.   if (y>6.9 & y<7.4) 
  112.     i = 1 
  113.     tmp = 0;
  114.     xp = xb
  115.     while (i<=num) 
  116.       if (x>=xp & x<=xp+xi); tmp=i; endif
  117.       i = i + 1
  118.       xp = xp + xi
  119.     endwhile
  120.     if (tmp>0)
  121.       c = tmp
  122.       'set line 0'
  123.       'draw recf 5.2 6.3 5.7 6.8'
  124.       'set string 1 c 6'
  125.       'set strsiz 0.16 0.18'
  126.       'draw string 5.5 6.5 'c
  127.       tmp = 1 + 4*red.c/255
  128.       'set line 0'
  129.       'draw recf 3.1 0.8 4.5 5.1'
  130.       'set line 1 1 1'
  131.       'draw line 3.1 'tmp' 3.3 'tmp
  132.       'set string 1 l 1'
  133.       'draw string 3.5 'tmp' 'red.c
  134.       tmp = 1 + 4*green.c/255
  135.       'set line 0'
  136.       'draw recf 5.6 0.8 7.0 5.1'
  137.       'set line 1 1 1'
  138.       'draw line 5.6 'tmp' 5.8 'tmp
  139.       'set string 1 l 1'
  140.       'draw string 6.0 'tmp' 'green.c
  141.       tmp = 1 + 4*blue.c/255
  142.       'set line 0'
  143.       'draw recf 8.1 0.8 9.5 5.1'
  144.       'set line 1 1 1'
  145.       'draw line 8.1 'tmp' 8.3 'tmp
  146.       'set string 1 l 1'
  147.       'draw string 8.5 'tmp' 'blue.c
  148.     endif
  149.   endif
  150.   flag = 0
  151.   if (y>1 & y<5 & x>2.5 & x<3.5) 
  152.     tmp = 255*(y-1)/4
  153.     red.c = int(tmp) 
  154.     tmp = 1 + 4*red.c/255
  155.     'set line 0'
  156.     'draw recf 3.1 0.8 4.5 5.1'
  157.     'set line 1 1 1'
  158.     'draw line 3.1 'tmp' 3.3 'tmp
  159.     'set string 1 l 1'
  160.     'draw string 3.5 'tmp' 'red.c
  161.     flag = 1
  162.   endif
  163.   if (y>1 & y<5 & x>5.0 & x<6.0) 
  164.     tmp = 255*(y-1)/4
  165.     green.c = int(tmp)
  166.     tmp = 1 + 4*green.c/255
  167.     'set line 0'
  168.     'draw recf 5.6 0.8 7.0 5.1'
  169.     'set line 1 1 1'
  170.     'draw line 5.6 'tmp' 5.8 'tmp
  171.     'set string 1 l 1'
  172.     'draw string 6.0 'tmp' 'green.c
  173.     flag = 1
  174.   endif
  175.   if (y>1 & y<5 & x>7.5 & x<8.5) 
  176.     tmp = 255*(y-1)/4
  177.     blue.c = int(tmp)
  178.     tmp = 1 + 4*blue.c/255
  179.     'set line 0'
  180.     'draw recf 8.1 0.8 9.5 5.1'
  181.     'set line 1 1 1'
  182.     'draw line 8.1 'tmp' 8.3 'tmp
  183.     'set string 1 l 1'
  184.     'draw string 8.5 'tmp' 'blue.c
  185.     flag = 1
  186.   endif
  187.   if (flag) 
  188.     cnum = c+39
  189.     'set rgb 'cnum' 'red.c' 'green.c' 'blue.c
  190.     'set line 'cnum
  191.     x1 = xb+xi*(c-1)
  192.     x2 = x1+xi
  193.     'draw recf 'x1' 7 'x2' 7.3'
  194.   endif
  195. endwhile
  196.  
  197. i = 1
  198.  
  199. close (fname)
  200.  
  201. while (i<=num) 
  202.   say i'   red = 'red.i'  green = 'green.i'   blue = 'blue.i
  203.   ctab=i' 'red.i' 'green.i' 'blue.i
  204.   rc = write ( fname ,ctab)
  205.   i = i + 1
  206. endwhile
  207.  
  208. 'quit'
  209.  
  210. return
  211.  
  212. function int(stuff)
  213.  
  214.   res = ''
  215.   i = 1
  216.   c = substr(stuff,i,1)
  217.   while (c!='' & ('x'%c)!='x.') 
  218.     res = res%c
  219.     i = i + 1
  220.     c = substr(stuff,i,1)
  221.   endwhile
  222.   return res
  223.